home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / pcrnov89.arc / PP.ARC / PP.BAS < prev    next >
BASIC Source File  |  1990-03-21  |  12KB  |  567 lines
  1.   DEFINT A-Z
  2.   ON ERROR GOTO TESTERROR
  3. START:
  4.   COLOR 7, 1: CLS
  5. ' -- Initialize string arrays --
  6.   NE = 12
  7.   DIM ACTION$(6 TO 17), CONTROL$(6 TO 17)
  8.   DIM BT$(3 TO 5), CT$(3 TO 5), EM$(1 TO 5)
  9.   DIM RADDRESS$(NE, 2 TO 5)
  10.   DIM ADDRESS$(NE, 11 TO 15), ATTN$(NE)
  11.   DIM MENU$(3), MESSAGE$(5)
  12. ' -- Setup string variables --
  13.   NUM$ = " A B C D E F G H I J K L"
  14.   BLK$ = STRING$(50, 32)
  15.   H$ = STRING$(50, 205)
  16.   BLK2$ = STRING$(27, 32)
  17.   B$ = CHR$(194) + STRING$(22, 196) + CHR$(182)
  18.   A$ = STRING$(9, 32) + "ACTION" + STRING$(10, 32)
  19.  
  20.   BT$(3) = CHR$(201) + LEFT$(H$, 25) + CHR$(187)
  21.   BT$(4) = CHR$(186) + A$ + CHR$(186)
  22.   BT$(5) = CHR$(199) + STRING$(2, 196) + B$
  23.  
  24.   BL0$ = CHR$(207) + LEFT$(H$, 22) + CHR$(188)
  25.   BL1$ = CHR$(200) + LEFT$(H$, 2) + BL0$
  26.   BL2$ = CHR$(179) + LEFT$(BLK$, 22) + CHR$(186)
  27.  
  28.   CT1$ = LEFT$(BLK$, 20) + CHR$(186)
  29.   CT0$ = LEFT$(BLK$, 16) + "CONTROL STRING" + CT1$
  30.  
  31.   CT$(3) = CHR$(201) + H$ + CHR$(187)
  32.   CT$(4) = CHR$(186) + CT0$
  33.   CT$(5) = CHR$(199) + STRING$(50, 196) + CHR$(182)
  34.  
  35.   CT4$ = CHR$(186) + BLK$ + CHR$(186)
  36.   CT5$ = CHR$(200) + H$ + CHR$(188)
  37.  
  38.   MENU$(1) = CHR$(201) + LEFT$(H$, 36) + CHR$(187)
  39.   MENU$(2) = CHR$(186) + LEFT$(BLK$, 36) + CHR$(186)
  40.   MENU$(3) = CHR$(200) + LEFT$(H$, 36) + CHR$(188)
  41.  
  42.   RET$ = "<" + STRING$(2, 196) + CHR$(217)
  43.   TE$ = "  to EXIT "
  44.  
  45.   MESSAGE$(1) = "<S>end  <A>ssign  <E>nvelope  <Q>uit"
  46.   MESSAGE$(2) = "  <A>ction    <C>ontrol    <E>xit   "
  47.   MESSAGE$(3) = RET$ + "  to SEND       <Esc> to EXIT  "
  48.   MESSAGE$(4) = " Type Action String   " + RET$ + TE$
  49.   MESSAGE$(5) = "Type Control String   " + RET$ + TE$
  50.  
  51.   UK$ = CHR$(0) + CHR$(72): DK$ = CHR$(0) + CHR$(80)
  52.   LK$ = CHR$(0) + CHR$(75): RK$ = CHR$(0) + CHR$(77)
  53.   HOME$ = CHR$(0) + CHR$(71): END$ = CHR$(0) + CHR$(79)
  54.   PGUP$ = CHR$(0) + CHR$(73): PGDN$ = CHR$(0) + CHR$(81)
  55.   PRNT$ = CHR$(0) + CHR$(59)
  56.  
  57.   EM$(1) = " <F1> Print     "
  58.   EM$(2) = "<PG UP> Next    "
  59.   EM$(3) = "<PG DN> Previous    "
  60.   EM$(4) = "<TAB> Advance   "
  61.   EM$(5) = "<ESC> Exit"
  62.  
  63.   FOR J = 6 TO 17
  64.    CST = LEN(CONTROL$(J))
  65.    AST = LEN(ACTION$(J))
  66.    CONTROL$(J) = CONTROL$(J) + STRING$(50 - CST, 32)
  67.    ACTION$(J) = ACTION$(J) + STRING$(22 - AST, 32)
  68.   NEXT
  69.  
  70.   FOR JJ = 1 TO NE
  71.  
  72.     FOR J = 2 TO 5
  73.      RADDRESS$(JJ, J) = STRING$(29, 32)
  74.     NEXT
  75.  
  76.     FOR J = 11 TO 15
  77.      ADDRESS$(JJ, J) = STRING$(40, 32)
  78.     NEXT
  79.  
  80.     FOR HJ = 1 TO 12
  81.      ATTN$(HJ) = STRING$(41, 32)
  82.     NEXT
  83.  
  84.   NEXT
  85. ' -- Load data file from disk --
  86. 9999 OPEN "PP.DAT" FOR INPUT AS #1
  87.  
  88.       FOR J = 6 TO 17
  89.        INPUT #1, CONTROL$(J)
  90.        INPUT #1, ACTION$(J)
  91.       NEXT
  92.  
  93.   FOR JJ = 1 TO NE
  94.  
  95.     FOR J = 2 TO 5
  96.      INPUT #1, RADDRESS$(JJ, J)
  97.     NEXT
  98.  
  99.     FOR J = 11 TO 15
  100.      INPUT #1, ADDRESS$(JJ, J)
  101.     NEXT
  102.  
  103.     INPUT #1, ATTN$(JJ)
  104.   NEXT
  105.  
  106.   CLOSE 1
  107.   GOSUB GETPIC
  108. '-- Display message headers --
  109. GETKEYS:
  110. DO
  111.   X$ = INKEY$
  112.    X$ = UCASE$(X$)
  113.     SELECT CASE X$
  114.      CASE "S"
  115.       GOSUB SEND
  116.       ACTION = 0: GOSUB GATHER
  117.       MESSAGE = 1
  118.       GOSUB MENUBAR
  119.      CASE "A"
  120.       GOSUB ASSIGN
  121.      CASE "Q"
  122.       GOSUB SAVEFILE: CLS : END
  123.      CASE "E"
  124.       COLOR 15, 1: CLS
  125.       GOSUB PRINTENV
  126.       CLS : GOSUB GETPIC: JJ = 1
  127.      CASE ELSE
  128.       END SELECT
  129.  LOOP
  130. ' -- Assign action/control string --
  131. ASSIGN:
  132.   MESSAGE = 2
  133.   GOSUB MESSAGEBAR
  134.  DO
  135.   X$ = INKEY$
  136.     X$ = UCASE$(X$)
  137.      SELECT CASE X$
  138.        CASE "A"
  139.          MESSAGE = 4: GOSUB MESSAGEBAR
  140.          ACTION = 1: GOSUB BEXIT: RETURN
  141.        CASE "C"
  142.         MESSAGE = 5: GOSUB MESSAGEBAR
  143.         ACTION = 2: GOSUB BEXIT: RETURN
  144.        CASE "E"
  145.         MESSAGE = 1: GOSUB MENUBAR
  146.        CASE ELSE
  147.          END SELECT
  148.  LOOP
  149. ' -- Turn on edit mode / get strings --
  150. BEXIT:
  151.    LEDIT = 1
  152.    GOSUB GETSET
  153.    GOSUB GETSIDE
  154.    GOSUB GATHER
  155.    MESSAGE = 1
  156.    GOSUB MESSAGEBAR
  157.    LEDIT = 0
  158.    RETURN
  159. ' -- Send control string to printer --
  160. SEND:
  161.   MESSAGE = 3
  162.   GOSUB MENUBAR
  163.   ACTION = 1
  164.   LEDIT = 0
  165.   ACCEPT = YES
  166.   GOSUB GETSET
  167.   GOSUB GETSIDE
  168.   GOSUB GATHER
  169.  
  170.   IF ACTION = 0 THEN RETURN
  171.    J = 0: B$ = ""
  172.    C$ = RTRIM$(LTRIM$(CONTROL$(CLNE))) + ","
  173. DO
  174.   J = J + 1
  175.   IF J > LEN(C$) THEN EXIT DO
  176.      A$ = MID$(C$, J, 1)
  177.  
  178.      IF A$ = "#" THEN
  179.         LPRINT MID$(C$, 2, LEN(C$) - 2); CHR$(13); CHR$(10)
  180.         EXIT DO
  181.      END IF
  182.  
  183.       IF A$ = "," OR J = LEN(C$) THEN
  184.         LPRINT CHR$(VAL(B$)); : B$ = ""
  185.       ELSE
  186.         B$ = B$ + A$
  187.       END IF
  188. LOOP
  189. RETURN
  190. ' -- Move cursor / get info from display --
  191. GETSET:
  192.   IF ACTION > 2 THEN ACTION = 1
  193.  
  194.   IF ACTION = 1 THEN
  195.     MAXPOS = 26: MINPOS = 5: MAXLNE = 17: MINLNE = 6
  196.   END IF
  197.  
  198.   IF ACTION = 2 THEN
  199.    MAXPOS = 79: MINPOS = 30: MAXLNE = 17: MINLNE = 6
  200.   END IF
  201.  
  202.   CPOS = MINPOS: CLNE = MINLNE
  203.   RETURN
  204.  
  205. GETSIDE:
  206.   LOCATE MINLNE, MINPOS
  207.   GOSUB GATHER
  208.   COLOR 0, 7: LOCATE MINLNE, MINPOS
  209.   GOSUB GATHER
  210.  
  211. MOVECUR:
  212.  DO
  213.   X$ = INKEY$
  214.      SELECT CASE (X$)
  215.       CASE ""
  216.        IF LEDIT THEN GOSUB FLASH
  217.          
  218.       CASE CHR$(13)
  219.        ACCEPT = YES: GOSUB GATHER: RETURN
  220.    
  221.       CASE CHR$(27)
  222.        ACCEPT = NO: ACTION = 0: RETURN
  223.      
  224.      CASE UK$
  225.       IF CLNE > MINLNE THEN
  226.        COLOR 7, 0: GOSUB GATHER
  227.        CLNE = CLNE - 1
  228.        COLOR 0, 7: GOSUB GATHER
  229.       END IF
  230.   
  231.     CASE DK$
  232.      IF CLNE < MAXLNE THEN
  233.       COLOR 7, 0: GOSUB GATHER
  234.       CLNE = CLNE + 1
  235.       COLOR 0, 7: GOSUB GATHER
  236.      END IF
  237.  
  238.     CASE LK$
  239.      IF LEDIT THEN
  240.       IF CPOS > MINPOS THEN CPOS = CPOS - 1
  241.      END IF
  242.   
  243.    CASE RK$
  244.     IF LEDIT THEN
  245.       IF CPOS < MAXPOS THEN
  246.        CPOS = CPOS + 1: GOTO MOVECUR
  247.       END IF
  248.     END IF
  249.    
  250.    CASE CHR$(8)
  251.     IF CPOS > MINPOS THEN
  252.       LOCATE CLNE, CPOS: PRINT " ";
  253.       CPOS = CPOS - 1
  254.     END IF
  255.   
  256.    CASE HOME$
  257.     LOCATE CLNE, MINPOS: CPOS = MINPOS
  258.  
  259.    CASE END$
  260.     LOCATE CLNE, MAXPOS: CPOS = MAXPOS
  261.  
  262.    CASE CHR$(32) TO CHR$(127)
  263.     IF LEDIT THEN
  264.       LOCATE CLNE, CPOS: PRINT X$;
  265.       IF CPOS < MAXPOS THEN CPOS = CPOS + 1
  266.     END IF
  267.      
  268.    CASE ELSE
  269.     END SELECT
  270.        
  271.     IF ACTION = 1 AND LEDIT = 0 THEN
  272.       X$ = UCASE$(X$)
  273.       IF X$ > CHR$(64) AND X$ < CHR$(77) THEN
  274.         COLOR 7, 0: GOSUB GATHER
  275.         CLNE = ASC(X$) - 59
  276.         COLOR 0, 7: GOSUB GATHER
  277.       END IF
  278.     END IF
  279.  LOOP
  280. ' -- Grab string from display --
  281. GATHER:
  282.    GATHER$ = ""
  283.  
  284.   FOR NPOS = MINPOS TO MAXPOS
  285.    GATHER$ = GATHER$ + CHR$(SCREEN(CLNE, NPOS))
  286.   NEXT
  287.  
  288.   LOCATE CLNE, MINPOS
  289.    IF ACTION = 0 OR REXIT THEN COLOR 7, 0
  290.    IF ACTION = 1 THEN ACTION$(CLNE) = GATHER$
  291.    IF ACTION = 2 THEN CONTROL$(CLNE) = GATHER$
  292.    IF ACTION = 3 THEN RADDRESS$(JJ, CLNE) = GATHER$
  293.    IF ACTION = 4 THEN ADDRESS$(JJ, CLNE) = GATHER$
  294.    IF ACTION = 5 THEN ATTN$(JJ) = GATHER$
  295.    PRINT GATHER$; : RETURN
  296.  
  297. ' -- Flash cursor --
  298. FLASH:
  299.   FL$ = CHR$(SCREEN(CLNE, CPOS))
  300.   COLOR 7, 0: LOCATE CLNE, CPOS: PRINT CHR$(219);
  301.   GOSUB PAUSE
  302.   COLOR 7, 0: LOCATE CLNE, CPOS: PRINT FL$;
  303.   GOSUB PAUSE
  304.   RETURN
  305. ' -- Pause timer --
  306. PAUSE:
  307.   T! = TIMER: WHILE T! = TIMER: WEND: RETURN
  308. '-- Print title and form  --
  309. ACTION:
  310.   COLOR 7, 4
  311.   PRINT BLK2$; "PC RESOURCE PRINTER PRIMER"; BLK2$
  312.   COLOR 0, 7
  313.  
  314.   FOR LNE = 3 TO 5
  315.    LOCATE LNE, 1: PRINT BT$(LNE);
  316.   NEXT
  317.  
  318.   SPOS = 1
  319.  
  320.   FOR LNE = 6 TO 17
  321.    LOCATE LNE, 1:
  322.    PRINT CHR$(186); MID$(NUM$, SPOS, 2); BL2$;
  323.    SPOS = SPOS + 2
  324.   NEXT
  325.  
  326.   LOCATE LNE, 1: PRINT BL1$;
  327.   COLOR 7, 1
  328.   RETURN
  329.  
  330. CONTROL:
  331.   COLOR 0, 7
  332.   FOR LNE = 3 TO 5
  333.    LOCATE LNE, 29: PRINT CT$(LNE);
  334.   NEXT
  335.  
  336.   FOR LNE = 6 TO 17
  337.    LOCATE LNE, 29: PRINT CT4$
  338.   NEXT
  339.  
  340.   LOCATE 18, 29: PRINT CT5$;
  341.   RETURN
  342.  
  343. MENUBAR:
  344.   FOR LNE = 20 TO 22
  345.    LOCATE LNE, 20: PRINT MENU$(LNE - 19);
  346.   NEXT
  347.  
  348. MESSAGEBAR:
  349.   LOCATE 21, 21: PRINT MESSAGE$(MESSAGE);
  350.   RETURN
  351. ' -- Save data file to disk --
  352. SAVEFILE:
  353.   OPEN "PP.DAT" FOR OUTPUT AS #1
  354.    FOR J = 6 TO 17
  355.     WRITE #1, CONTROL$(J)
  356.     WRITE #1, ACTION$(J)
  357.    NEXT
  358.  
  359.   FOR JJ = 1 TO NE
  360.     FOR J = 2 TO 5
  361.      WRITE #1, RADDRESS$(JJ, J)
  362.     NEXT
  363.  
  364.     FOR J = 11 TO 15
  365.       WRITE #1, ADDRESS$(JJ, J)
  366.     NEXT
  367.  
  368.      WRITE #1, ATTN$(JJ)
  369.   NEXT
  370.  
  371.   CLOSE 1
  372.   RETURN
  373. ' -- Print envelope template  --
  374. MAKENVELOPE:
  375.   COLOR 0, 7
  376.   LOCATE 1, 1
  377.   PRINT CHR$(218); STRING$(78, 196) + CHR$(191);
  378.  
  379.   FOR LNES = 2 TO 23
  380.     LOCATE LNES, 1
  381.     PRINT CHR$(179); TAB(80); CHR$(179);
  382.   NEXT
  383.  
  384.   LOCATE 24, 1
  385.    PRINT CHR$(192) + STRING$(78, 196) + CHR$(217);
  386.   RETURN
  387. ' --  Envelope data entry --
  388. PRINTENV:
  389.   LOCATE 25, 1
  390.  
  391.   FOR J = 1 TO 5
  392.    PRINT EM$(J);
  393.   NEXT
  394.  
  395.   GOSUB MAKENVELOPE: COLOR 7, 0
  396.   GOSUB GETENVELOPE: ACTION = 3
  397.   GOSUB ACTPARM
  398.  
  399.  DO
  400.   X$ = INKEY$
  401.     SELECT CASE (X$)
  402.       CASE ""
  403.        GOSUB FLASH
  404.       CASE CHR$(27)
  405.        RETURN
  406.       CASE CHR$(13)
  407.        CPOS = MINPOS
  408.        COLOR 7, 0: GOSUB GATHER: COLOR 0, 7
  409.  
  410.        IF CLNE < MAXLNE THEN
  411.         CLNE = CLNE + 1
  412.        ELSE
  413.         CLNE = MINLNE
  414.        END IF
  415.  
  416.       CASE CHR$(9)
  417.        REXIT = 1: GOSUB GATHER: REXIT = 0
  418.        ACTION = ACTION + 1: GOSUB ACTPARM
  419.       CASE CHR$(8)
  420.        IF CPOS > MINPOS THEN CPOS = CPOS - 1
  421.       CASE HOME$
  422.        LOCATE CLNE, MINPOS: CPOS = MINPOS
  423.       CASE END$
  424.        LOCATE CLNE, MAXPOS: CPOS = MAXPOS
  425.       CASE UK$
  426.        IF CLNE > MINLNE THEN
  427.         GOSUB GATHER: CLNE = CLNE - 1
  428.        END IF
  429.  
  430.       CASE DK$
  431.        IF CLNE < MAXLNE THEN
  432.         GOSUB GATHER: CLNE = CLNE + 1
  433.        END IF
  434.  
  435.       CASE LK$
  436.        IF CPOS > MINPOS THEN CPOS = CPOS - 1
  437.       CASE RK$
  438.        IF CPOS < MAXPOS THEN CPOS = CPOS + 1
  439.       CASE CHR$(32) TO CHR$(127)
  440.        LOCATE CLNE, CPOS: COLOR 7, 0: PRINT X$;
  441.        IF CPOS < MAXPOS THEN CPOS = CPOS + 1
  442.       CASE PRNT$
  443.        GOSUB SENDPRINT
  444.       CASE PGUP$
  445.        JJ = JJ + 1: GOSUB GETENVELOPE
  446.       CASE PGDN$
  447.        JJ = JJ - 1: GOSUB GETENVELOPE
  448.       CASE ELSE
  449.    END SELECT
  450.  LOOP
  451. ' -- Assign action code --
  452. ACTPARM:
  453.   IF ACTION > 5 THEN ACTION = 3
  454.  
  455.   IF ACTION = 3 THEN
  456.    MAXPOS = 32: MINPOS = 4
  457.    MAXLNE = 5: MINLNE = 2
  458.   END IF
  459.  
  460.   IF ACTION = 4 THEN
  461.     MAXPOS = 67: MINPOS = 28
  462.     MAXLNE = 15: MINLNE = 11
  463.   END IF
  464.  
  465.   IF ACTION = 5 THEN
  466.     MAXPOS = 44: MINPOS = 4
  467.     MAXLNE = 23: MINLNE = 23
  468.   END IF
  469.  
  470.   CPOS = MINPOS: CLNE = MINLNE
  471.   RETURN
  472. '-- Reprint the form  --
  473. GETPIC:
  474.   YES = 1: NO = 0
  475.   GOSUB ACTION: GOSUB CONTROL
  476.   MESSAGE = 1: GOSUB MENUBAR: COLOR 7, 0
  477.  
  478.   FOR J = 6 TO 17
  479.    LOCATE J, 5: PRINT ACTION$(J);
  480.    LOCATE J, 30: PRINT CONTROL$(J);
  481.   NEXT
  482.  
  483.  RETURN
  484. ' -- Print envelope address --
  485. GETENVELOPE:
  486.   IF JJ > NE THEN JJ = 1
  487.   IF JJ < 1 THEN JJ = NE
  488.   LOCATE 2, 67
  489.   PRINT "ENVELOPE :"; : PRINT USING "##"; JJ;
  490.  
  491.   FOR J = 2 TO 5
  492.    LOCATE J, 4: PRINT RADDRESS$(JJ, J);
  493.   NEXT
  494.  
  495.   FOR J = 11 TO 15
  496.    LOCATE J, 28: PRINT ADDRESS$(JJ, J);
  497.   NEXT
  498.  
  499.   LOCATE 23, 4: PRINT ATTN$(JJ)
  500.   RETURN
  501. ' --- Send address to printer ----
  502. SENDPRINT:
  503.    LPRINT
  504.    FOR J = 2 TO 5
  505.     LPRINT TAB(5); RADDRESS$(JJ, J)
  506.    NEXT
  507.  
  508.    FOR J = 6 TO 10
  509.     LPRINT
  510.    NEXT
  511.  
  512.    FOR J = 11 TO 15
  513.     LPRINT TAB(29); ADDRESS$(JJ, J)
  514.    NEXT
  515.  
  516.    FOR J = 16 TO 22
  517.     LPRINT
  518.    NEXT
  519.  
  520.    LPRINT TAB(5); ATTN$(JJ)
  521.    RETURN
  522. ' -- Error Handler --
  523. TESTERROR:
  524.   IF ERR > 23 AND ERR < 28 OR ERR = 68 THEN
  525.        GOSUB ASKERR: RESUME NEXT
  526.    END IF
  527. ' -- Start a new file --
  528.   IF ERL = 9999 THEN
  529.      IF ERR = 53 THEN GOSUB SAVEFILE: RESUME 9999
  530.   END IF
  531.   CLS : PRINT "Error "; ERR; " in line "; ERL;
  532.   CLOSE : END
  533. ASKERR:
  534.     BEEP: SMESS$ = ""
  535.  
  536.     FOR SAVEMESS = 1 TO 80
  537.      SMESS$ = SMESS$ + CHR$(SCREEN(25, SAVEMESS))
  538.     NEXT
  539.  
  540.     LOCATE 25, 1
  541.     COLOR 7, 1: PRINT STRING$(80, 32);
  542.     LOCATE 25, 1
  543.     PRINT "Printer not responding";
  544.     PRINT "<RETURN> Continue  <ESC> Quit";
  545. DO
  546.   X$ = INKEY$
  547.      SELECT CASE (X$)
  548.       CASE CHR$(13)
  549.        LOCATE 25, 1: PRINT SMESS$; : RETURN
  550.       CASE CHR$(27)
  551.        GOSUB SAVEFILE: CLS : END
  552.       CASE ELSE
  553.         END SELECT
  554. LOOP
  555.  
  556.  
  557.  
  558.  
  559.  
  560.  
  561.  
  562.  
  563.  
  564.  
  565.  
  566.  
  567.